Mac Magazin/MacEasy 127/maccd 127.iso/software/osx-graphicviewer_folder.sit/osx-graphicviewer Folder/Graphic Viewer.source

Text File | 2005-03-06 | 54.1 KB | 2,476 lines | [TEXT/????]

MyApp.LoadPrefs:
Sub LoadPrefs()
  WColor.LoadPrefs
  WInfo.LoadPrefs
  WMagnify.LoadPrefs
End Sub

MyApp.newWindow:
Sub newWindow(pi as Pic)
  windowlist.append pi.winid
  windowlistrefs.append new WindowItem
  pi.setWindow(window_x, window_y)
  window_x = window_x + window_incr
  window_y = window_y + window_incr
End Sub

MyApp.WindowStart:
Sub WindowStart()
  ' set up for window operations
  dim i as integer
  #if TargetWin32 then
    window_left = 10
    window_right = window_left + MDIWindow.Width
    window_top = 10 + window_topmargin
    window_bottom = window_top + MDIWindow.Height
  #else
    window_left = Screen(0).AvailableLeft
    window_right = window_left + Screen(0).AvailableWidth
    window_top = Screen(0).AvailableTop + window_topmargin
    window_bottom = window_top + Screen(0).AvailableHeight
  #endif
  window_x = window_left
  window_y = window_top
  window_count = 0
  for i = 0 to WindowCount - 1
    if WindowPic(i) then
      window_count = window_count + 1
    end
  next
End Sub

MyApp.WindowPic:
Function WindowPic(i as integer) As boolean
  return Window(i) isa Pic and Window(i).Title <> "##"
End Function

MyApp.getWindowName:
Function getWindowName(wi as integer) As string
  dim i as integer
  dim pi as Pic
  for i = 0 to WindowCount - 1
    if WindowPic(i) then
      pi = Pic(Window(i))
      if pi.winid = wi then
        return Window(i).Title
      end
    end
  next
  return "window #" + str(wi)
End Function

MyApp.WindowClose:
Sub WindowClose(pi as Pic)
  dim i as integer
  for i = 1 to Ubound(windowlist)
    if windowlist(i) = pi.winid then
      windowlist(i) = -1
      WindowItem(i).Visible = false
    end
  next
End Sub

MyApp.Close:
Sub Close()
  isquitting = true
  Pool.Save
End Sub

MyApp.OpenDocument:
Sub OpenDocument(item As FolderItem)
  Dim pi as Pic
  Dim p as Picture
  Dim mi as MenuItem

  pi = new Pic
  if pi <> Nil then
    p = item.OpenAsPicture
    if p <> Nil then
      pi.setPic(item, p)
      openrecentlist.append item
      if Ubound(openrecentlist) > 0 then
        mi = new OpenRecentItem
      end
      newWindow(pi)
    else
      MsgBox "Unable to read image from " + item.Name
    end
  else
    MsgBox "Unable to create window for " + item.Name
  end
End Sub

MyApp.EnableMenuItems:
Sub EnableMenuItems()
  dim i as integer

  #if TargetWin32 then
    FilePrint.Enable
  #endif
  #if TargetLinux then
    FilePrint.Enable
  #endif

  if Ubound(openrecentlist) >= 0 then
    FileOpenRecent.Enable
  end
  for i = 0 to Ubound(openrecentlist)
    OpenRecentItem(i).Text = openrecentlist(i).Name
    OpenRecentItem(i).Enable
  next

  if Ubound(openrecentlist) >= 0 then
    FileOpenRecent.Enable
  end
  for i = 0 to Ubound(openrecentlist)
    OpenRecentItem(i).Text = openrecentlist(i).Name
    OpenRecentItem(i).Enable
  next

  if UBound(windowlist) > 0 then
    WindowArrangeStaggered.Enable
    WindowArrangeLefttoRight.Enable
    WindowArrangeToptoBottom.Enable
    WindowArrangeTiled.Enable
  end

  WindowItem(0).Text = "-"
  WindowItem(0).Enabled = false
  for i = 1 to Ubound(windowlist)
    if windowlist(i) >= 0 then
      WindowItem(i).Text = getWindowName(windowlist(i))
      WindowItem(i).Enable
      if windowlist(i) = App.w.getFront then
        WindowItem(i).Checked = true
      else
        WindowItem(i).Checked = false
      end
    end
  next
End Sub

MyApp.Open:
Sub Open()
  isquitting = false

  imagefilter = "image/pict;image/gif;image/jpeg;image/png;image/tiff;image/x-bmp;image/x-pict;image/x-png;image/x-tiff"

  WColor.Hide
  WInfo.Hide
  WMagnify.Hide
  if not Fin.Init("com.finseth", "Graphic Viewer", "GraphicViewer") then Quit

  FC = new FileColors
  if FC = Nil then
    MsgBox "Can't create FC"
    Quit
  end
  if not FC.Load("web-colors.txt") then
  end

  pbt = new PBThread
  if pbt = Nil then
    MsgBox "Can't create PB thread"
    Quit
  end

  sst = new SSThread
  if sst = Nil then
    MsgBox "Can't create SS thread"
    Quit
  end

  if w = Nil then
    w = new WindowList
    if w = Nil then
      MsgBox "Can't create WindowList"
      Quit
    end
    w.init
  end

  LoadPrefs

  #if targetWin32 then
    if FileQuit <> Nil then
      FileQuit.Text = "E&xit"
      FileQuit.CommandKey =  ""
      WinBase.Visible = true
    end
  #endif
  #if TargetLinux then
    WinBase.Visible = true
  #endif

  window_topmargin = 40

  window_x = 10
  window_y = 10 + window_topmargin
  window_incr = 30
End Sub

About.Open:
Sub Open()
  self.Title = "About " + Fin.AppName
  NameStr.Text = Fin.AppName + Fin.SPACE + Fin.AppVersion
End Sub

About.OKButton.Action:
Sub Action()
  About.Hide
End Sub

Pic.SaveFile:
Sub SaveFile(ask as boolean)
  if ExportPicture(Image_p) then
    CheckChanged.Value = false
  end
End Sub

Pic.setInfo:
Sub setInfo()
  WInfo.setSize(image_p.width, image_p.height, image_p.HorizontalResolution)
End Sub

Pic.PicChange:
Sub PicChange(winchanged as boolean)
  dim scale, s as integer
  dim targeth, targetw as integer

  if image_p = Nil then
    return
  end
  scale = ViewScales(ViewScalePopup.ListIndex)

  if scale = -1 then
    ' fit width
    if Can.width < 20 then
      scale = 20 * 100 / image_p.width
    else
      scale = Can.width * 100 / image_p.width
    end
  elseif scale = -2 then
    'fit height
    if Can.height < 20 then
      scale = 20 * 100 / image_p.height
    else
      scale = Can.height * 100 / image_p.height
    end
  elseif scale = -3 then
    ' fit both
    if Can.width < 20 then
      scale = 20 * 100 / image_p.width
    else
      scale = Can.width * 100 / image_p.width
    end
    if Can.height < 20 then
      s = 20 * 100 / image_p.height
    else
      s = Can.height * 100 / image_p.height
    end
    if s < scale then
      scale = s
    end
  elseif scale = -3 then
    ' fit screen
    scale = Screen(0).width * 100 / image_p.width
    s = Screen(0).height * 100 / image_p.height
    if s < scale then
      scale = s
    end
  end

  targetw = image_p.width * scale / 100
  targeth = image_p.height * scale / 100

  scroll_x = 0
  scroll_y = 0
  ScrollH.Value = 0
  ScrollV.Value = 0
  if Can.width > targetw then
    ScrollH.Visible = false
  else
    ScrollH.Visible = true
    ScrollH.Maximum = targetw - Can.width
    ScrollH.PageStep = Can.width
  end
  if Can.height > targeth then
    ScrollV.Visible = false
  else
    ScrollV.Visible = true
    ScrollV.Maximum = targeth - Can.height
    ScrollV.PageStep = Can.height
  end

  display_p = NewPicture(targetw, targeth, 32)
  if display_p = Nil then
    MsgBox "Not enough memory to allocate working buffer"
  else
    display_p.graphics.drawPicture image_p, 0, 0, targetw, targeth, 0, 0, image_p.width, image_p.height
  end
  Can.Refresh
End Sub

Pic.SizeChanged:
Sub SizeChanged()
  Can.width = me.width - ScrollV.width
  Can.height = me.height - Can.Top - ScrollH.Height
  PicChange(true)
  ScrollV.Left = me.width - ScrollV.width
  ScrollV.Height = me.height - Can.Top - ScrollH.height
  ScrollH.Top = me.height - ScrollH.height
  ScrollH.Width = me.width - ScrollV.width
End Sub

Pic.setPic:
Sub setPic(f as folderitem, pi as Picture)
  image_p = pi
  undo_p = pi
  scroll_x = 0
  scroll_y = 0

  display_p = Nil
  PicChange(true)

  Pic.width = display_p.width + ScrollV.width
  Pic.height = display_p.height + ScrollH.height + Can.Top
  SizeChanged

  if f <> Nil then
    me.Title = f.Name
  else
    me.Title = "Untitled"
  end
  me.show
  CheckChanged.Value = false
  setInfo
End Sub

Pic.setWindow:
Sub setWindow(x as integer, y as integer)
  me.Left = x
  me.Top = y
End Sub

Pic.OpStart:
Sub OpStart(op as string)
  undo_p = image_p
  EditUndo.Text = "Undo " + op
End Sub

Pic.OpEnd:
Sub OpEnd()
  CheckChanged.Value = true
  PicChange(false)
  WInfo.setSize(image_p.width, image_p.height, image_p.HorizontalResolution)
End Sub

Pic.Draw:
Sub Draw(ps as printersetup, g as Graphics)
  Fin.ImageSizer(image_p.Width, image_p.Height, Fin.PrinterWidth, Fin.PrinterHeight)
  'MsgBox "i_pW=" + str(image_p.Width) + ", i_pH=" + str(image_p.Height) + ", pW=" + str(Fin.PrinterWidth) + ", pH=" + stR(Fin.PrinterHeight) + Fin.NL + "IL=" + str(Fin.ImageLeft) + ", IT=" + str(Fin.ImageTop) + ", IW=" + str(Fin.ImageWidth) + ", IH=" + stR(Fin.ImageHeight)
  g.drawPicture image_p, Fin.ImageLeft, Fin.ImageTop, Fin.ImageWidth,  Fin.ImageHeight, 0, 0, image_p.Width, image_p.Height
End Sub

Pic.Close:
Sub Close()
  App.WindowClose(self)
End Sub

Pic.Resized:
Sub Resized()
  SizeChanged
End Sub

Pic.MouseMove:
Sub MouseMove(X As Integer, Y As Integer)
  if App.w.getFront = winid then
    WInfo.setXY(x, y)
  end
End Sub

Pic.Activate:
Sub Activate()
  App.w.setFront(winid)
  if image_p <> Nil then
    setInfo
  end
End Sub

Pic.CancelClose:
Function CancelClose(appQuitting as Boolean) As Boolean
  if CheckChanged.Value then
    Fin.WindowCenter(SaveChanges)
    #if TargetCarbon then
      SaveChanges.ShowModalWithin(self)
    #else
      SaveChanges.ShowModal
    #endif
    if SaveChanges.pressed = "Save" then
      SaveFile(false)
    elseif SaveChanges.pressed = "Cancel" then
      return true
    end
    SaveChanges.Close
  end
  return false
End Function

Pic.EnableMenuItems:
Sub EnableMenuItems()
  if CheckChanged.Value then
    FileSave.Enable
  end
  FileSaveAs.Enable
  FileClose.Enable
  if undo_p <> Nil then
    EditUndo.Enable
  else
    EditUndo.Text = "Can't Undo"
  end
  EditCopy.Enable
  EditInvert.Enable
  EditPaste.Enable
  EditImageSize.Enable
  EditCanvasSize.Enable
  EditRotateCW.Enable
  EditRotateCCW.Enable
  EditRotate180.Enable
  EditMirrorHoriz.Enable
  EditMirrorVert.Enable
  EditSettoFillColor.Enable
  EditInvert.Enable
  EditConverttoWebColors.Enable
  EditConverttoGrayscale.Enable
End Sub

Pic.Open:
Sub Open()
  image_p = Nil
  undo_p = Nil

  winid = App.w.getWinId

  ViewScalePopup.addRow "10%"
  ViewScales(0) = 10
  ViewScalePopup.addRow "25%"
  ViewScales(1) = 25
  ViewScalePopup.addRow "33%"
  ViewScales(2) = 33
  ViewScalePopup.addRow "50%"
  ViewScales(3) = 50
  ViewScalePopup.addRow "75%"
  ViewScales(4) = 75
  ViewScalePopup.addRow "100%"
  ViewScales(5) = 100
  ViewScalePopup.addRow "125%"
  ViewScales(6) = 125
  ViewScalePopup.addRow "150%"
  ViewScales(7) = 150
  ViewScalePopup.addRow "200%"
  ViewScales(8) = 200
  ViewScalePopup.addRow "300%"
  ViewScales(9) = 300
  ViewScalePopup.addRow "400%"
  ViewScales(10) = 400
  ViewScalePopup.addRow "1000%"
  ViewScales(11) = 1000
  ViewScalePopup.addRow "fit width"
  ViewScales(12) = -1
  ViewScalePopup.addRow "fit height"
  ViewScales(13) = -2
  ViewScalePopup.addRow "fit best"
  ViewScales(14) = -3
  ViewScalePopup.addRow "fit screen"
  ViewScales(15) = -4
  ViewScalePopup.ListIndex = 14
End Sub

Pic.ViewScalePopup.Change:
Sub Change()
  PicChange(false)
End Sub

Pic.Can.Paint:
Sub Paint(g As Graphics)
  if display_p <> Nil then
    g.drawPicture display_p, 0, 0, g.width, g.height, scroll_x, scroll_y, g.width, g.height
  end
End Sub

Pic.ScrollV.ValueChanged:
Sub ValueChanged()
  scroll_y = me.Value
  Can.Refresh
End Sub

Pic.ScrollH.ValueChanged:
Sub ValueChanged()
  scroll_x = me.Value
  Can.Refresh
End Sub

WColor.DoIt:
Sub DoIt()
  dim x, y, ix as Integer
  dim r, g, b as integer
  dim i, j, k as Double
  dim s as String
  dim c as Color

  if not WColor.Visible then
    return
  end
  x = System.MouseX
  y = System.MouseY
  c = System.Pixel(x, y)
  XY.Text = "(" + cstr(x) + "," + cstr(y) + ")"

  Rect.FillColor = c

  r = c.Red
  g = c.Green
  b = c.Blue
  RGBD.Text = "RGB " + Str(r) + "," + Str(g) + "," + Str(b)

  RGBH.Text = Fin.Hex2(r) + "," + Fin.Hex2(g) + "," + Fin.Hex2(b)

  i = c.Hue
  j = c.Saturation
  k = c.Value
  xIHS.Text = "HSV " + cstr(Fin.R3(i)) + "," + cstr(Fin.R3(j)) + "," + cstr(Fin.R3(k))

  i = c.Cyan
  j = c.Magenta
  k = c.Yellow
  xCMY.Text = "CMY " + cstr(Fin.R3(i)) + "," + cstr(Fin.R3(j)) + "," + cstr(Fin.R3(k))

  c = App.FC.GetWebColor(c)
  r = c.Red
  g = c.Green
  b = c.Blue
  WebSafe.Text = "Web Safe #" + Fin.Hex2(r) + Fin.Hex2(g) + Fin.Hex2(b)
  ix = App.FC.GetIndex(c)
  WebIndex.Text = "Web Index " + str(ix)
  WebName.Text = "Web Name " + App.FC.GetName(ix)
End Sub

WColor.Draw:
Sub Draw(ps as printersetup, g as Graphics)
  dim x, y, ix as Integer
  dim r, gr, b as integer
  dim i, j, k as Double
  dim c, wc as Color
  dim yy, size as integer

  yy = Fin.PrinterTop + g.TextHeight * Fin.PrinterScale
  size = g.TextSize * Fin.PrinterScale

  x = System.MouseX
  y = System.MouseY
  c = System.Pixel(x, y)
  g.drawString "(" + cstr(x) + "," + cstr(y) + ")", Fin.PrinterLeft, yy
  yy = yy + size

  r = c.Red
  gr = c.Green
  b = c.Blue
  g.DrawString "RGB " + Str(r) + "," + Str(gr) + "," + Str(b), Fin.PrinterLeft, yy
  yy = yy + size

  g.drawString "RGB(hex) " + Fin.Hex2(r) + "," + Fin.Hex2(gr) + "," + Fin.Hex2(b), Fin.PrinterLeft, yy
  yy = yy + size

  i = c.Hue
  j = c.Saturation
  k = c.Value
  g.drawString "HSV " + cstr(Fin.R3(i)) + "," + cstr(Fin.R3(j)) + "," + cstr(Fin.R3(k)), Fin.PrinterLeft, yy
  yy = yy + size

  i = c.Cyan
  j = c.Magenta
  k = c.Yellow
  g.drawString "CMY " + cstr(Fin.R3(i)) + "," + cstr(Fin.R3(j)) + "," + cstr(Fin.R3(k)), Fin.PrinterLeft, yy
  yy = yy + size

  wc = App.FC.GetWebColor(c)
  r = wc.Red
  gr = wc.Green
  b = wc.Blue
  g.drawString "Web Safe #" + Fin.Hex2(r) + Fin.Hex2(gr) + Fin.Hex2(b), Fin.PrinterLeft, yy
  yy = yy + size

  ix = App.FC.GetIndex(wc)
  g.drawString "Web Index " + str(ix), Fin.PrinterLeft, yy
  yy = yy + size

  g.drawString "Web Safe #" + "Web Name " + App.FC.GetName(ix), Fin.PrinterLeft, yy
  yy = yy + size

  g.ForeColor = c
  g.fillRect Fin.PrinterLeft, yy, ps.HorizontalResolution, ps.VerticalResolution
End Sub

WColor.LoadPrefs:
Sub LoadPrefs()
  dim i as Integer
  dim b as Boolean

  if Pool.GetI("Color.Left", i) then
    self.Left = i
  end

  if Pool.GetI("Color.Top", i) then
    self.Top = i
  end

  Fin.WindowSane(self)

  if Pool.GetB("Color.Checked", b) then
    if b then
      InfoColor.Checked = true
      self.Show
    end
  end

  Pool.SetI("Color.Left", self.Left)
  Pool.SetI("Color.Top", self.Top)
  Pool.SetB("Color.Checked", InfoColor.Checked)
End Sub

WColor.CancelClose:
Function CancelClose(appQuitting as Boolean) As Boolean
  App.isquitting = true
End Function

WColor.Close:
Sub Close()
  InfoColor.Checked = false
  if not App.isquitting then Pool.SetB("Color.Checked", InfoColor.Checked)
End Sub

WColor.Activate:
Sub Activate()
  App.w.setFront(winid)
End Sub

WColor.Moved:
Sub Moved()
  Pool.SetI("Color.Left", self.Left)
  Pool.SetI("Color.Top", self.Top)
End Sub

WColor.Open:
Sub Open()
  if App.w = Nil then
    App.w = new WindowList
    if App.w = Nil then
      MsgBox "Can't create WindowList"
      Quit
    end
    App.w.init
  end
  winid = App.w.getWinId
End Sub

WColor.Timer1.Action:
Sub Action()
  DoIt
End Sub

WMagnify.setMag:
Sub setMag(m as Integer)
  mag = m
  if mag = 2 then
    But2.Value = true
    Pool.SetS("Magnify.Mag", "2x")
  elseif mag = 4 then
    But4.Value = true
    Pool.SetS("Magnify.Mag", "4x")
  else
    But8.Value = true
    mag = 8
    Pool.SetS("Magnify.Mag", "8x")
  end
End Sub

WMagnify.getMag:
Function getMag() As Integer
  return mag
End Function

WMagnify.DoIt:
Sub DoIt()
  dim g as Graphics
  dim e, i, j, ex, ey as Integer
  dim x, y as integer

  if not WMagnify.Visible then
    return
  end

  x = System.MouseX
  y = System.MouseY
  g = Area.Graphics
  e = g.width / mag
  ex = x - e / 2
  ey = y - e / 2
  for i = 0 to e
    for j = 0 to e
      g.ForeColor = System.Pixel(ex + i, ey + j)
      g.FillRect i * mag, j * mag, mag, mag
    next
  next
End Sub

WMagnify.Draw:
Sub Draw(ps as printersetup, g as Graphics)
  dim e, i, j, ex, ey as Integer
  dim x, y as integer
  x = System.MouseX
  y = System.MouseY
  e = Area.Graphics.width / mag
  ex = x - e / 2
  ey = y - e / 2
  for i = 0 to e
    for j = 0 to e
      g.ForeColor = System.Pixel(ex + i, ey + j)
      g.FillRect Fin.PrinterLeft + i * mag, Fin.PrinterTop + j * mag, mag, mag
    next
  next
End Sub

WMagnify.LoadPrefs:
Sub LoadPrefs()
  dim i as Integer
  dim b as Boolean
  dim s as String

  if Pool.GetI("Magnify.Left", i) then
    self.Left = i
  end

  if Pool.GetI("Magnify.Top", i) then
    self.Top = i
  end

  Fin.WindowSane(self)

  if Pool.GetB("Magnify.Checked", b) then
    if b then
      InfoMagnify.Checked = true
      self.Show
    else
      InfoMagnify.Checked = false
      self.Hide
    end
  end

  if Pool.GetS("Magnify.Mag", s) then
    if s = "2x" then
      But2.Value = true
    elseif s = "4x" then
      But4.Value = true
    else
      But8.Value = true
    end
  end

  Pool.SetI("Magnify.Left", self.Left)
  Pool.SetI("Magnify.Top", self.Top)
  Pool.SetB("Magnify.Checked", InfoMagnify.Checked)

  if But2.Value then
    s = "2x"
  elseif But4.Value then
    s = "4x"
  else
    s = "8x"
  end
  Pool.SetS("Magnify.Mag", s)
End Sub

WMagnify.CancelClose:
Function CancelClose(appQuitting as Boolean) As Boolean
  App.isquitting = true
End Function

WMagnify.Moved:
Sub Moved()
  Pool.SetI("Magnify.Left", self.Left)
  Pool.SetI("Magnify.Top", self.Top)
End Sub

WMagnify.Close:
Sub Close()
  InfoMagnify.Checked = false
  if not App.isquitting then Pool.SetB("Magnify.Checked", InfoMagnify.Checked)
End Sub

WMagnify.Activate:
Sub Activate()
  App.w.setFront(winid)
End Sub

WMagnify.Open:
Sub Open()
  setMag(8)
  if App.w = Nil then
    App.w = new WindowList
    if App.w = Nil then
      MsgBox "Can't create WindowList"
      Quit
    end
    App.w.init
  end
  winid = App.w.getWinId
End Sub

WMagnify.But2.Action:
Sub Action()
  setMag(2)
End Sub

WMagnify.But4.Action:
Sub Action()
  setMag(4)
End Sub

WMagnify.But8.Action:
Sub Action()
  setMag(8)
End Sub

WMagnify.Timer1.Action:
Sub Action()
  DoIt
End Sub

FileColors.DoLine:
Sub DoLine(cnt as integer, s as string)
  dim ss as String = s
  dim colr as String
  dim cname as String

  'skip blank, short, or comment lines
  if Len(ss) < 8 or Left(ss, 1) = "#" then
    return
  end

  colr = Fin.SplitOff(Fin.TAB, ss)
  if colr = "" or Len(colr) <> 6 then
    MsgBox "Missing Color on line " + str(cnt)
    return
  end

  cname = ss
  if cname = "" then
    MsgBox "Missing Name on line " + str(cnt)
    return
  end

  dim c as Color = Fin.SToColor(colr)
  dim i as Integer = App.FC.GetIndex(c)
  Names(i) = cname
End Sub

FileColors.GetIndex:
Function GetIndex(c as Color) As integer
  dim cc as Color
  cc = GetWebColor(c)
  return cc.Red / 51 * 36 + cc.Green / 51 * 6 + cc.Blue / 51
End Function

FileColors.GetName:
Function GetName(i as integer) As string
  return Names(i)
End Function

FileColors.GetWebColor:
Function GetWebColor(c as Color) As Color
  dim r, g, b as integer
  r = (c.Red + 26) / 51
  r = r * 51
  g = (c.Green + 26) / 51
  g = g * 51
  b = (c.Blue + 26) / 51
  b = b * 51
  return RGB(r, g, b)
End Function

FileColors.Load:
Function Load(fn as string) As boolean
  dim f as folderItem
  dim i as integer
  dim s as TextInputStream

  for i = 0 to 215
    Names(i) = "-"
  next

  f = GetFolderItem(fn)
  if f = Nil or not f.Exists then
    return true
  end

  s = f.OpenAsTextFile
  i = 1
  while not s.EOF
    DoLine(i, s.ReadLine)
    i = i + 1
  wend
  s.Close
  return true
End Function

WInfo.setSize:
Sub setSize(x as integer, y as integer, r as integer)
  dim rr as double
  rr = r
  WidthP.Text = "w: " + cstr(x)
  HeightP.Text = "h: " + cstr(y)
  WidthD.Text = "w: " + cstr(x / rr) + " in"
  HeightD.Text = "h: " + cstr(y / rr) + " in"
  ResolutionD.Text = "res: " + cstr(r) + "/in"
  Memory.Text = Fin.formatMemory(1.0 * x * y * 32 / 8)
End Sub

WInfo.LoadPrefs:
Sub LoadPrefs()
  dim i as Integer
  dim b as Boolean
  dim c as Color

  if Pool.GetI("Info.Left", i) then
    self.Left = i
  end

  if Pool.GetI("Info.Top", i) then
    self.Top = i
  end

  Fin.WindowSane(self)
  if Pool.GetB("Info.Checked", b) then
    if b then
      InfoInfo.Checked = true
      self.Show
    end
  end

  if Pool.GetC("Info.Color", c) then
    FillClr.FillColor = c
  end

  Pool.SetI("Info.Left", self.Left)
  Pool.SetI("Info.Top", self.Top)
  Pool.SetB("Info.Checked", InfoInfo.Checked)
  Pool.SetC("Info.Color", FillClr.FillColor)
End Sub

WInfo.setXY:
Sub setXY(x as integer, y as integer)
  XP.Text = "x: " + cstr(x)
  YP.Text = "y: " + cstr(y)
End Sub

WInfo.setFillColor:
Sub setFillColor(c as Color)
  FillClr.FillColor = c
  Pool.SetC("Info.Color", FillClr.FillColor)
End Sub

WInfo.getFillColor:
Function getFillColor() As Color
  return FillClr.FillColor
End Function

WInfo.Draw:
Sub Draw(ps as printerSetup, g as graphics)
  dim yy, size as integer

  yy = Fin.PrinterTop + g.TextHeight * Fin.PrinterScale
  size = g.TextSize * Fin.PrinterScale

  g.drawString XP.Text, Fin.PrinterLeft, yy
  yy = yy + size

  g.drawString YP.Text, Fin.PrinterLeft, yy
  yy = yy + size

  g.drawString WidthP.Text, Fin.PrinterLeft, yy
  yy = yy + size

  g.drawString HeightP.Text, Fin.PrinterLeft, yy
  yy = yy + size

  g.drawString WidthD.Text, Fin.PrinterLeft, yy
  yy = yy + size

  g.drawString HeightD.Text, Fin.PrinterLeft, yy
  yy = yy + size

  g.drawString ResolutionD.Text, Fin.PrinterLeft, yy
  yy = yy + size

  g.drawString Memory.Text, Fin.PrinterLeft, yy
  yy = yy + size

  g.drawString "fill color: (" + str(FillClr.FillColor.Red)  + "," + str(FillClr.FillColor.Green)  + "," + str(FillClr.FillColor.Blue)  + ")", Fin.PrinterLeft, yy
End Sub

WInfo.CancelClose:
Function CancelClose(appQuitting as Boolean) As Boolean
  App.isquitting = true
End Function

WInfo.Moved:
Sub Moved()
  Pool.SetI("Info.Left", self.Left)
  Pool.SetI("Info.Top", self.Top)
End Sub

WInfo.Activate:
Sub Activate()
  App.w.setFront(winid)
End Sub

WInfo.Close:
Sub Close()
  InfoInfo.Checked = false
  if not App.isquitting then Pool.SetB("Info.Checked", InfoInfo.Checked)
End Sub

WInfo.Open:
Sub Open()
  InfoInfo.Checked = false
  setXY(0, 0)
  setSize(1, 1, 72)
  setFillColor(RGB(0, 0, 0))

  if App.w = Nil then
    App.w = new WindowList
    if App.w = Nil then
      MsgBox "Can't create WindowList"
      Quit
    end
    App.w.init
  end
  winid = App.w.getWinId
End Sub

WInfo.FillClr.MouseDown:
Function MouseDown(X As Integer, Y As Integer) As Boolean
  Dim c as Color
  c = FillClr.FillColor
  if selectColor(c, "Select Fill Color") then
    FillClr.FillColor = c
  end
End Function

SaveChanges.ButCancel.Action:
Sub Action()
  pressed = "Cancel"
  hide
End Sub

SaveChanges.ButSave.Action:
Sub Action()
  pressed = "Save"
  hide
End Sub

SaveChanges.ButDont.Action:
Sub Action()
  pressed = "DontSave"
  hide
End Sub

SaveChanges.Canvas1.Paint:
Sub Paint(g As Graphics)
  g.drawCautionIcon 0, 0
End Sub

WindowList.setFront:
Sub setFront(x as integer)
  front = x
End Sub

WindowList.init:
Sub init()
  front = 0
  winid = 0
End Sub

WindowList.getFront:
Function getFront() As integer
  return front
End Function

WindowList.getWinId:
Function getWinId() As integer
  winid = winid + 1
  return winid
End Function

NewDialog.ButOK.Action:
Sub Action()
  pressed = "OK"
  hide
End Sub

NewDialog.ButCancel.Action:
Sub Action()
  pressed = "Cancel"
  hide
End Sub

PBThread.Start:
Function Start(range as integer) As integer
  ProgBar.PB.Value = 0
  Fin.WindowCenter(ProgBar)
  ProgBar.Show
  return range / 100
End Function

PBThread.Done:
Sub Done()
  ProgBar.Hide
End Sub

PBThread.Run:
Sub Run()
  ProgBar.PB.Value = App.pbvalue
  ProgBar.PB.Refresh
End Sub

SlideShow.go:
Sub go(f as folderItem)
  if f.directory then
    dir_f = f
  else
    dir_f = f.parent
  end
  if dir_f = Nil or not dir_f.directory then
    MsgBox "unable to access directory for " + f.Name
    return
  end
  if dir_f.count < 1 then
    MsgBox "no files"
    return
  end
  current = 1
  total = dir_f.count - 1
  pressed = ""
  starting = true
  #if TargetWin32 then
    SlideShow.Left = 10
    SlideShow.Top = 10
    SlideShow.Width = App.MDIWindow.Width - 20
    SlideShow.Height = App.MDIWindow.Height - 20
  #else
    SlideShow.Left = Screen(0).AvailableLeft
    SlideShow.Top = Screen(0).AvailableTop + App.window_topmargin
    SlideShow.Width = Screen(0).AvailableWidth - SlideShow.Left
    SlideShow.Height = Screen(0).AvailableHeight - SlideShow.Top
  #endif
  SlideShow.Can.Width = SlideShow.Width
  SlideShow.Can.Height = SlideShow.Height - SlideShow.Can.Top
  SlideShow.Show
  App.sst.Run
End Sub

SlideShow.doit:
Sub doit()
  if starting then
    starting = false
  else
    if pressed = "stop" then
      SlideShow.Hide
      return
    elseif pressed = "pause" then
      return
    elseif pressed = "first" then
      current = 1
    elseif pressed = "last" then
      current = total
    elseif pressed = "-10" then
      current = current - 10
      if current < 1 then
        current = 1
      end
    elseif pressed = "+10" then
      current = current + 10
      if current > total then
        current = total
      end
    else
      if RadBackward.Value then
        current = current - 1
      else
        current = current + 1
      end
    end
    pressed = ""
    if current < 1 or current > total then
      SlideShow.hide
    end
    App.sst.run
  end
End Sub

SlideShow.ButFirst.Action:
Sub Action()
  pressed = "first"
  doit
End Sub

SlideShow.ButM10.Action:
Sub Action()
  pressed = "-10"
  doit
End Sub

SlideShow.ButPause.Action:
Sub Action()
  if ButPause.Caption = "Pause" then
    ButPause.Caption = "Play"
    pressed = "pause"
  else
    ButPause.Caption = "Pause"
    pressed = ""
  end
End Sub

SlideShow.ButP10.Action:
Sub Action()
  pressed = "+10"
  doit
End Sub

SlideShow.ButLast.Action:
Sub Action()
  pressed = "last"
  doit
End Sub

SlideShow.ButStop.Action:
Sub Action()
  pressed = "stop"
  doit
End Sub

SlideShow.Timer1.Action:
Sub Action()
  doit
End Sub

ImageSize.button:
Sub button(s as double)
  EditWidth.Text = cstr(floor(App.image_width * s))
  EditWidth.SelStart = 0
  EditWidth.SelLength = len(EditWidth.Text)
  EditHeight.Text = cstr(floor(App.image_height * s))
  EditHeight.SelStart = 0
  EditHeight.SelLength = len(EditHeight.Text)
End Sub

ImageSize.Open:
Sub Open()
  updating = ""
End Sub

ImageSize.But4x.Action:
Sub Action()
  button(4)
End Sub

ImageSize.But3x.Action:
Sub Action()
  button(3)
End Sub

ImageSize.But2x.Action:
Sub Action()
  button(2)
End Sub

ImageSize.But15x.Action:
Sub Action()
  button(1.5)
End Sub

ImageSize.ButD15.Action:
Sub Action()
  button(1 / 1.5)
End Sub

ImageSize.ButD2.Action:
Sub Action()
  button(1/2)
End Sub

ImageSize.ButD3.Action:
Sub Action()
  button(1/3)
End Sub

ImageSize.ButD4.Action:
Sub Action()
  button(1/4)
End Sub

ImageSize.EditWidth.TextChange:
Sub TextChange()
  if CheckKeep.Value and updating <> "h" then
    updating = "w"
    EditHeight.Text = cstr(floor(1.0 * App.image_height / App.image_width * cdbl(EditWidth.Text)))
    EditHeight.SelStart = 0
    EditHeight.SelLength = len(EditHeight.Text)
    updating = ""
  end
End Sub

ImageSize.EditHeight.TextChange:
Sub TextChange()
  if CheckKeep.Value and updating <> "w" then
    updating = "h"
    EditWidth.Text = cstr(floor(1.0 * App.image_width / App.image_height * cdbl(EditHeight.Text)))
    EditWidth.SelStart = 0
    EditWidth.SelLength = len(EditWidth.Text)
    updating = ""
  end
End Sub

ImageSize.ButOK.Action:
Sub Action()
  pressed = "ok"
  App.image_width = cdbl(EditWidth.Text)
  if App.image_width < 1 then
    App.image_width = 1
  end
  App.image_height = cdbl(EditHeight.Text)
  if App.image_height < 1 then
    App.image_height = 1
  end
  hide
End Sub

ImageSize.ButCancel.Action:
Sub Action()
  pressed = "cancel"
  hide
End Sub

CanvasSize.ButCancel.Action:
Sub Action()
  pressed = "cancel"
  hide
End Sub

CanvasSize.ButOK.Action:
Sub Action()
  pressed = "ok"
  App.image_width = cdbl(EditWidth.Text)
  if App.image_width < 1 then
    App.image_width = 1
  end
  App.image_height = cdbl(EditHeight.Text)
  if App.image_height < 1 then
    App.image_height = 1
  end
  hide
End Sub

CanvasSize.Fill.MouseDown:
Function MouseDown(X As Integer, Y As Integer) As Boolean
  Dim c as Color
  c = Winfo.FillClr.FillColor
  if selectColor(c, "Select Fill Color") then
    WInfo.FillClr.FillColor = c
    Fill.FillColor = c
  end
End Function

SSThread.Run:
Sub Run()
  Dim p as Picture
  dim w, h as integer
  dim scale, s as double

  if SlideShow.dir_f.item(SlideShow.current) <> Nil then

    SlideShow.Count.Text = cstr(SlideShow.current) + "/" + cstr(SlideShow.total)
    SlideShow.FileName.Text = SlideShow.dir_f.item(SlideShow.current).AbsolutePath

    SlideShow.Can.graphics.foreColor = RGB(0, 0, 0)
    SlideShow.Can.graphics.fillRect 0, 0, SlideShow.Can.width, SlideShow.Can.height
    p = SlideShow.dir_f.item(SlideShow.current).OpenAsPicture
    if p <> Nil then
      ' fit both
      scale = SlideShow.Can.width / p.width
      w = SlideShow.Can.width
      h = p.height * scale
      s = SlideShow.Can.height / p.height
      if s < scale then
        w = p.width * s
        h = SlideShow.Can.height
      end
      SlideShow.Can.graphics.drawPicture p, 0, 0, w, h, 0, 0, p.width, p.height
    else
      SlideShow.Can.graphics.foreColor = RGB(255, 255, 255)
      SlideShow.Can.graphics.drawString "Not a graphics file", 50, 50
    end
  end
End Sub

FinUpdate.PhaseOne:
Protected Sub PhaseOne()
  Message.Text = "Check for Updates?"
  ButCancel.Visible = true
  ButOK.Visible = true
  PBar.Visible = false
  phase = "one"
End Sub

FinUpdate.PhaseTwo:
Protected Sub PhaseTwo()
  Message.Text = "Checking..."
  PBar.Visible = true
  phase = "two"
  HP.Get(Fin.VersionURL)
End Sub

FinUpdate.PhaseThree:
Protected Sub PhaseThree(content as String)
  if Len(content) < 10 then
    NotFound
    return
  end

  dim a(-1) as String = Split(content, "<release>")
  if UBound(a) < 1 then
    NotFound
    return
  end

  dim i as Integer
  dim lookfor as String = "<program>" + Fin.AppName + "</program>"
  for i = 0 to UBound(a) - 1
    if InStr(a(i), lookfor) > 0 and Found(a(i)) then return
  next
  NotFound
End Sub

FinUpdate.NotFound:
Protected Sub NotFound()
  Message.Text = "No newer version found."
  PBar.Visible = false
  ButOK.Visible = true
  ButCancel.Visible = false
End Sub

FinUpdate.Found:
Protected Function Found(s as String) As Boolean
  ' found possible release, return true if OK or false if we should keep looking

  'MsgBox "Found: " + s

  dim lookfor as String = "<target>" + Fin.TargetSystem + "</target>"
  if InStr(s, lookfor) <=  0 then return false
  'MsgBox "Matched TargetSystem of " + Fin.TargetSystem

  dim i as Integer = InStr(s, "<version>")
  dim j as Integer = InStr(s, "</version>")
  if i <= 0 or j <= 0 then return false
  rVersion = Mid(s, i + 9, j - i - 9)
  'MsgBox "Found version of " + rVersion
  if rVersion <= Fin.AppVersion then return false

  i = InStr(s, "<date>")
  j = InStr(s, "</date>")
  if i <= 0 or j <= 0 then return false
  rDate = Mid(s, i + 6, j - i - 6)
  'MsgBox "Found date of " + rDate

  i = InStr(s, "<size>")
  j = InStr(s, "</size>")
  if i <= 0 or j <= 0 then return false
  rSize = Mid(s, i + 6, j - i - 6)
  'MsgBox "Found size of " + rSize

  i = InStr(s, "<url>")
  j = InStr(s, "</url>")
  if i <= 0 or j <= 0 then return false
  rURL = Mid(s, i + 5, j - i - 5)
  'MsgBox "Found URL of " + rURL

  phase = "four"
  return true
End Function

FinUpdate.PhaseFour:
Protected Sub PhaseFour()
  Message.Text = "A new version is available" + Fin.NL + Fin.NL
  Message.Text = Message.Text + "The new version is " + rVersion
  Message.Text = Message.Text + ", it was released on " + rDate
  Message.Text = Message.Text + ", and it is " + Fin.formatMemoryNice(val(rSize))
  Message.Text = Message.Text + ".  Do you want to load it (with your web browser)?"
  PBar.Visible = false
  ButCancel.Visible = true
  ButOK.Visible = true
  phase = "five"
End Sub

FinUpdate.Open:
Sub Open()
  phase = ""
End Sub

FinUpdate.Activate:
Sub Activate()
  if phase = "" then
    PhaseOne
  end
End Sub

FinUpdate.ButCancel.Action:
Sub Action()
  phase = ""
  self.Hide
End Sub

FinUpdate.ButOK.Action:
Sub Action()
  if phase = "one" then
    PhaseTwo
  elseif phase = "five" then
    ShowURL(rURL)
    phase = ""
    self.Hide
  else
    phase = ""
    self.Hide
  end
End Sub

FinUpdate.HP.PageReceived:
Sub PageReceived(url as string, httpStatus as integer, headers as internetHeaders, content as string)
  PhaseThree(content)
  if phase = "four" then PhaseFour
End Sub

FinUpdate.HP.Error:
Sub Error(code as integer)
  Message.Text = "There was a communications error with the web site.  Please try again later.  (Code: " + str(code) + ")"
  PBar.Visible = false
  ButOK.Visible = false
  phase = ""
End Sub

Pool.SetS:
Protected Sub SetS(n as String, s as String)
  ' save s under name n
  if p <> nil then p.Value(n) = s
  if b <> nil then b.Value(n) = 0
End Sub

Pool.SetB:
Protected Sub SetB(n as String, b as Boolean)
  ' save b under name n
  if p <> nil then p.Value(n) = b
End Sub

Pool.SetI:
Protected Sub SetI(n as String, i as Integer)
  ' save i under name n
  if p <> nil then p.Value(n) = i
End Sub

Pool.SetD:
Protected Sub SetD(n as String, d as Double)
  ' save d under name n
  if p <> nil then p.Value(n) = d
End Sub

Pool.SetBin:
Protected Sub SetBin(n as String, s as String)
  ' save s under name n
  if p <> nil then p.Value(n) = s
  if b <> nil then b.Value(n) = 1
End Sub

Pool.SetC:
Protected Sub SetC(n as String, c as Color)
  ' save c under name
  if p <> nil then p.Value(n) = c
End Sub

Pool.SetF:
Protected Sub SetF(n as String, f as FolderItem)
  ' save f under name n
  if p <> nil then p.Value(n) = f
End Sub

Pool.GetB:
Protected Function GetB(n as String, byref b as Boolean) As Boolean
  ' if n exists, set b to its value and return true else return false
  Mark(n)
  if p <> nil and p.HasKey(n) and p.Value(n).Type = kBoolean then
    b = p.Value(n)
    return true
  else
    return false
  end
End Function

Pool.GetBin:
Protected Function GetBin(n as String, byref s as String) As Boolean
  ' if n exists, set s to its value and return true else return false
  ' binaries are just like strings except that their Encoding is always 0
  ' and they are always stored using base64
  Mark(n)
  if p <> nil and p.HasKey(n) and p.Value(n).Type = kString then
    s = p.Value(n)
    return true
  else
    return false
  end
End Function

Pool.GetC:
Protected Function GetC(n as String, byref c as Color) As Boolean
  ' if n exists, set d to its value and return true else return false
  Mark(n)
  if p <> nil and p.HasKey(n) and p.Value(n).Type = kColor then
    c = p.Value(n)
    return true
  else
    return false
  end
End Function

Pool.GetD:
Protected Function GetD(n as String, byref d as Double) As Boolean
  ' if n exists, set d to its value and return true else return false
  Mark(n)
  if p <> nil and p.HasKey(n) and p.Value(n).Type = kDouble then
    d = p.Value(n)
    return true
  else
    return false
  end
End Function

Pool.GetF:
Protected Function GetF(n as String, byref f as FolderItem) As Boolean
  ' if n exists, set f to its value and return true else return false
  Mark(n)
  if p <> nil and p.HasKey(n) and p.Value(n).Type = kObject then
    f = p.Value(n)
    return true
  else
    return false
  end
End Function

Pool.GetI:
Protected Function GetI(n as String, byref i as Integer) As Boolean
  ' if n exists, set i to its value and return true else return false
  Mark(n)
  if p <> nil and p.HasKey(n) and p.Value(n).Type = kInteger then
    i = p.Value(n)
    return true
  else
    return false
  end
End Function

Pool.GetS:
Protected Function GetS(n as String, byref s as String) As Boolean
  ' if n exists, set s to its value and return true else return false
  Mark(n)
  if p <> nil and p.HasKey(n) and p.Value(n).Type = kString then
    s = p.Value(n)
    return true
  else
    return false
  end
End Function

Pool.Mark:
Private Sub Mark(n as String)
  ' mark the name to be permanently saved
  if m <> nil then m.Value(n) = 1
End Sub

Pool.Init:
Protected Function Init(domain as String, program as String) As Boolean
  #if DebugOpen then
    MsgBox "Pool Init Start"
  #endif
  filename = domain + ".prefs." + program

  p = new Dictionary
  b = new Dictionary
  m = new Dictionary
  if p = nil or b = nil or m = nil then
    MsgBox "Unable to initialize preferences"
    return false
  end
  return Reload
End Function

Pool.Reload:
Protected Function Reload() As Boolean
  p.Clear     ' pool for holding values
  m.Clear     ' set to 1 if name is to be saved
  b.Clear     ' for strings, set to 1 for binary, 0 for string

  dim f as FolderItem
  dim fs as TextInputStream
  f = PreferencesFolder.child(filename)
  if f = nil then
    f = GetFolderItem(filename)
    if f = nil then
      MsgBox "Unable to locate file " + filename
      return false
    end
  end

  fs = f.OpenAsTextFile
  if fs = nil then return true     ' no previous file

  while not fs.EOF
    ReloadItem fs.ReadLine
  wend
  fs.Close
  return true
End Function

Pool.Save:
Protected Sub Save()
  dim f as FolderItem
  dim fs as TextOutputStream
  f = SaveGetFolder
  if f = nil then return

  fs = f.CreateTextFile
  if fs = Nil then
    MsgBox "Unable to create preferences file " + filename
    return
  end

  dim i as Integer
  dim s as String
  dim cnt as Integer = p.Count - 1
  dim a(-1) as String
  if cnt >= 0 then
    for i = 0 to cnt
      s = SaveFormat(p.Key(i))
      if s <> "" then a.Append s
    next
  end

  a.Sort
  cnt = UBound(a)
  if cnt >= 0 then
    for i = 0 to cnt
      fs.WriteLine a(i)
    next
  end
  fs.Close
End Sub

Pool.SaveGetFolder:
Private Function SaveGetFolder() As FolderItem
  dim f as FolderItem = PreferencesFolder.child(filename)
  if f <> Nil then return f

  f = GetFolderItem(filename)
  if f <> Nil then return f

  MsgBox "Unable to create preferences item " + filename
  return nil
End Function

Pool.SaveFormat:
Private Function SaveFormat(k as Variant) As String
  ' format the entry for writing
  dim t as String
  dim t2 as String
  dim v as String

  if not m.HasKey(k) then return ""     '  not marked for saving

  dim vb as Boolean
  dim vc as Color
  dim vd as Double
  dim vf as FolderItem
  dim vi as Integer
  dim vs as String

  dim i as Integer
  dim c as String
  dim isbin as Boolean

  dim d as Variant = p.Value(k)
  if d.Type = kBoolean then     ' boolean
    t = "b"
    t2 = "-"
    vb = d
    if vb then
      v = "true"
    else
      v = "false"
    end
    ' bin handled under string
  elseif d.Type = kColor then     ' color
    t = "c"
    t2 = "-"
    vc = d
    v = Fin.ColorToString(d)
  elseif d.Type = kDouble then     ' double
    t = "c"
    t2 = "-"
    vd = d
    v = Fin.formatFixedLong(d)
  elseif d.Type = kObject then     ' folder item
    t = "f"
    t2 = "-"
    vf = d
    v = EncodeBase64(vf.GetSaveInfo(nil, 0))
  elseif d.Type = kInteger then     ' integer
    t = "i"
    t2 = "-"
    vi = d
    v = Str(vi)
  elseif d.Type = kString then     ' string (and bin)
    if b.HasKey(k) and b.Value(k) = 1 then
      t = "bin"
      t2 = "-"
      vs = d
      v = EncodeBase64(vs)
    else
      t = "s"
      vs = d
      t2 = Fin.EncodingToString(vs.Encoding)
      isbin = false
      for i = 1 to Len(vs)
        c = vs.Mid(i, 1)
        if c < Fin.SPACE or c > "~" then
          isbin = true
          break
        end
      next
      if isbin then
        t = "sb"
        v = EncodeBase64(vs)
      else
        v = vs
      end
    end
  else
    t = "unk"
    t2 = "-"
    v = "-"
  end
  return k + Fin.TAB + t + Fin.TAB + t2 + Fin.TAB + v
End Function

Pool.ReloadItem:
Private Sub ReloadItem(s as String)
  dim a(-1) as String = s.Split(Fin.TAB)
  if UBound(a) <> 3 then return    ' format error

  dim vb as Boolean
  dim vc as Color
  dim vd as Double
  dim vf as FolderItem
  dim vi as Integer
  dim vs as String

  if a(1) = "b" then
    if a(3) = "true" then
      vb = true
    else
      vb = false
    end
    p.Value(a(0)) = vb
  elseif a(1) = "bin" then
    vs = DecodeBase64(a(3))
    vs = vs.DefineEncoding(nil)
    p.Value(a(0)) = vs
  elseif a(1) = "c" then
    vc = Fin.StringToColor(a(3))
    p.Value(a(0)) = vc
  elseif a(1) = "d" then
    vd = CDbl(a(3))
    p.Value(a(0)) = vd
  elseif a(1) = "f" then
    vf = GetFolderItem(DecodeBase64(a(3)))
    p.Value(a(0)) = vf
  elseif a(1) = "i" then
    vi = Val(a(3))
    p.Value(a(0)) = vi
  elseif a(1) = "s" then
    vs = a(3)
    vs = vs.DefineEncoding(Fin.StringToEncoding(a(2)))
    p.Value(a(0)) = vs
  elseif a(1) = "sb" then
    vs = DecodeBase64(a(3))
    vs = vs.DefineEncoding(Fin.StringToEncoding(a(2)))
    p.Value(a(0)) = vs
  else
    MsgBox "Unknown code '" + a(1) + "' found in Preferences...skipping"
    return     ' unknown code
  end
End Sub

Fin.Init:
Protected Function Init(adomain as String,  aname as String, astring as String) As Boolean
  ' domain is the preference domain
  ' appname is the name of the application as you want it displayed
  ' appstring is the name of the application with spaces and special characters removed
  ' version is the version string of the form #.#

  #if TargetWin32 then
    NL = Chr(13) + Chr(10)
    TargetSystem = "win"
  #endif
  #if TargetMacOS then
    NL = Chr(13)
    #if TargetCarbon then
      TargetSystem = "osx"
    #else
      TargetSystem = "os9"
    #endif
  #endif
  #if TargetLinux then
    NL = Chr(10)
    TargetSystem = "linux"
  #endif
  SPACE = "  "
  TAB = Chr(9)
  CR = Chr(13)
  LF = Chr(10)

  AppDomain = adomain
  AppName = aname
  AppString = astring
  AppVersion = Str(App.MajorVersion) + "." + Str(App.MinorVersion)
  AppLongVersion = AppVersion + "." + Str(App.BugVersion)

  FeedbackURL = "mailto:[e-mail]?subject=" + AppName + " " + AppVersion
  FeedbackURL = ReplaceAll(FeedbackURL, " ", "%20")

  'AppManualURL = GetFolderItem("").AbsolutePath + AppName + ".html"
  '#if TargetMacOS then
  'dim i as Integer = AppManualURL.InStr(":")
  'if i > 0 then AppManualURL = AppManualURL.Mid(i)
  'AppManualURL = AppManualURL.ReplaceAll(":", "/")
  '#endif
  '#if TargetWin32 then
  'AppManualURL = AppManualURL.ReplaceAll("\", "/")
  '#endif
  'AppManualURL = "file://" + AppManualURL.ReplaceAll(" ", "%20")
  'MsgBox "manual <" + fin.AppManualURL + ">"
  AppManualName = AppName + ".html"

  VersionURL = "http://www.finseth.com/versions/index.xml"

  printerSettings = ""
  pageSetupCalled = false

  if not Pool.Init(AppDomain, AppString) then return false

  dim s as String
  if Pool.GetBin("Fin.printerSettings", s) then printerSettings = s
  return true
End Function

Fin.WindowCenter:
Protected Sub WindowCenter(w as Window)
  ' center the window on the screen
  #if TargetWin32 then
    #if IsMDH then
      w.Left = (MDIWindow.Width - w.Width) / 2
      w.Top = (MDIWindow.Height - w.Height) / 2
    #else
      w.Left = (Screen(0).AvailableWidth - w.Width) / 2
      w.Top = (Screen(0).AvailableHeight - w.Height) / 2
    #endif
  #else
    w.Left = (Screen(0).AvailableWidth - w.Width) / 2
    w.Top = (Screen(0).AvailableHeight - w.Height) / 2
  #endif
End Sub

Fin.WindowSane:
Protected Sub WindowSane(w as Window)
  ' ensure that the window fits on the screen
  dim margin as Integer = 30
  dim sal, sat, sah, saw as Integer

  #if TargetWin32 then
    #if IsMDH then
      sal = 0
      sat = 0
      saw = MDIWindow.Width
      sah = MDIWindow.Height
    #else
      sal = Screen(0).AvailableLeft
      sat = Screen(0).AvailableTop
      sah = Screen(0).AvailableHeight
      saw = Screen(0).AvailableWidth
    #endif
  #else
    sal = Screen(0).AvailableLeft
    sat = Screen(0).AvailableTop
    sah = Screen(0).AvailableHeight
    saw = Screen(0).AvailableWidth
  #endif
  if w.Left < sal + margin then w.Left = sal + margin
  if w.Left > sal + saw - margin then w.Left = sal + saw - margin
  if w.Top < sat + margin then w.Top = sat + margin
  if w.Top > sat + sah - margin then w.Top = sat + sah - margin
  if w.Left + w.Width + margin > saw then w.Width = saw - margin - w.Left
  if w.Top + w.Height + margin > sah then w.Height = sah - margin - w.Top
End Sub

Fin.formatFixed:
Protected Function formatFixed(x as Double) As String
  ' like Format, but formats more intelligently
  dim ax as Double
  dim s as String
  ax = abs(x)

  if ax = 0 then
    return "0"
  elseif ax > 10000000000 or ax < 0.000000001 then
    return Format(x, "-#.##########e-")
  else
    s = Format(x, "-#######,###.##########")
    if Right(s, 1) = "." then
      s = Left(s, Len(s) - 1)
    end
    return s
  end
End Function

Fin.formatMemory:
Protected Function formatMemory(x as Double) As String
  ' format a memory value
  dim s as String = ""
  dim xx as Double = x

  if x < 0 then
    xx = -xx
    s = "-"
  end
  if xx < 1024 then
    return s + formatFixed(xx) + " B"
  elseif xx < 1024 * 1024 then
    return s + formatFixed(xx / 1024) + " KB"
  elseif xx < 1024 * 1024 * 1024 then
    return s + formatFixed(xx / (1024 * 1024)) + " MB"
  else
    return s + formatFixed(xx / (1024 * 1024 * 1024)) + " GB"
  end
End Function

Fin.Hex2:
Protected Function Hex2(x as Integer) As String
  ' return X as a 2-digit hex string
  dim s as String
  s = Lowercase(Hex(x))
  if Len(s) < 2 then
    return "0" + s
  else
    return s
  end
End Function

Fin.R3:
Protected Function R3(x as Double) As Double
  ' round to 3 decimal places
  return Floor(x * 1000) / 1000
End Function

Fin.SplitOff:
Protected Function SplitOff(c as String, byref s as String) As String
  ' return the first part of S up to but not including C; remove the returned data and C from S
  dim i as Integer = InStr(s, c)
  dim r as String

  if i <= 0 then
    r = s
    s = ""
    return r
  end
  r = Left(s, i - 1)
  s = Mid(s, i + 1)
  return r
End Function

Fin.SToN:
Protected Function SToN(s as String, b as Integer) As Integer
  ' treat S as an integer in base B (2 <= B <= 36) and return the value
  dim x as String = Lowercase(s)
  dim ret as integer
  dim c as integer

  while Len(x) > 0
    c = Asc(x)
    if c >= 48 and c <= 57 then
      ret = ret * b + (c - 48)
    elseif c >= 97 and c <= 102 then
      ret = ret * b + (c - 97 + 10)
    end
    x = Mid(x, 2)
  wend
  return ret
End Function

Fin.SToColor:
Protected Function SToColor(s as String) As Color
  ' S is RRGGBB form with RR, GG, and BB in hex
  return RGB(SToN(Left(s, 2), 16), SToN(Mid(s, 3, 2), 16), SToN(Mid(s, 5), 16))
End Function

Fin.StringToColor:
Protected Function StringToColor(s as String) As Color
  return RGB(SToN(Left(s, 2), 16), SToN(Mid(s, 3, 2), 16), SToN(Mid(s, 5, 2), 16))
End Function

Fin.ValE:
Protected Function ValE(s as String) As Double
  ' s is a number that can be in exponential form: convert it to a double
  dim m as String
  dim e as String
  dim mv as Double
  dim ev as Integer
  dim pv as Double
  dim i as Integer
  e = s
  m = SplitOff("e", e)
  if m = "" then
    m = "0"
    e = "0"
  end
  if e = "" then
    e = "0"
  end
  mv = Val(m)
  pv = 1
  ev = Val(e)
  if ev < 0 then
    ev = -ev
    for i = 1 to ev
      pv = pv * 10
    next
    pv = 1 / pv
  else
    for i = 1 to ev
      pv = pv * 10
    next
  end
  return mv * pv
End Function

Fin.InterpolateColor:
Protected Function InterpolateColor(c1 as Color, c2 as Color, i as Integer, n as Integer) As Color
  ' return the color that is i/n of the way from c1 to c2
  dim r, g, b as Integer
  r = c1.Red * (n - i) / n + c2.Red * i / n
  g = c1.Green * (n - i) / n + c2.Green * i / n
  b = c1.Blue * (n - i) / n + c2.Blue * i / n
  return RGB(r, g, b)
End Function

Fin.ColorToString:
Protected Function ColorToString(c as Color) As String
  return Hex2(c.Red) + Hex2(c.Green) + Hex2(c.Blue)
End Function

Fin.f2:
Protected Function f2(i as Integer) As String
  ' format i as a string ensuring that it is at least 2 digits long with 0 fill
  dim s as String = Str(i)
  if Len(s) < 2 then
    return "0" + s
  else
    return s
  end
End Function

Fin.f2s:
Protected Function f2s(i as Integer) As String
  ' format i as a string ensuring that it is at least 2 digits long with space fill
  dim s as String = Str(i)
  if Len(s) < 2 then
    return " " + s
  else
    return s
  end
End Function

Fin.formatBase:
Protected Function formatBase(x as Integer, b as Integer) As String
  ' format x in base b
  dim result as String = ""
  dim wasneg as Boolean = false
  dim xx as Integer = x
  dim c as Integer

  if xx = 0 then
    return "0"
  end

  if xx < 0 then
    wasneg = true
    xx = -xx
  end

  while xx > 0
    c = xx mod b
    if c >= 10 then
      result = Chr(c - 10 + 97) + result
    else
      result = Chr(c + 48) + result
    end
    xx = xx / b
  wend

  if wasneg then result = "-" + result

  return result
End Function

Fin.formatCarat:
Protected Function formatCarat(c as String) As String
  '  format the first character of c using ^ notation
  dim i as Integer
  dim v as Integer
  dim outs as String = ""
  dim cc as String = c

  if LenB(cc) > 1 then
    v = 0
    for i = 1 to LenB(cc) - 1
      v = v * 256 + AscB(MidB(cc, i, 1))
    next
    cc = RightB(cc, 1)
    outs = formatBase(v, 16) + "+"
  end
  i = AscB(cc)
  if i >= 128 then
    outs = outs + "~"
    i = i - 128
  end
  if i < 32 then
    outs = outs + "^"
    i = i + 64
  end
  if i = 127 then
    outs = outs + "^"
    i = i - 64
  end
  outs = outs + Chr(i)
  return outs
End Function

Fin.formatFixedLong:
Protected Function formatFixedLong(x as Double) As String
  ' like formatFixed, but makes longer number
  dim ax as Double = Abs(x)
  dim s as String

  if ax = 0 then
    return "0"
  elseif ax > 10000000000 or ax < 0.000000001 then
    return Format(x, "-#.###############e-")
  else
    s = Format(x, "-#######,###.###############")
    if Right(s, 1) = "." then
      s = Left(s, Len(s) - 1)
    end
    return s
  end
End Function

Fin.GCD:
Protected Function GCD(a as Integer, b as Integer) As Integer
  ' greatest common divisor
  dim x, y as Integer
  dim aa as Integer = a
  dim bb as Integer = b

  if aa = bb then return aa

  if aa <= 0 or bb <= 0 then return 1

  if bb > aa then return GCD(bb, aa)

  while true
    x = aa mod bb
    if x = 0 then return bb

    y = Floor(bb / x)
    if bb = y * x then return x

    aa = bb
    bb = x
  wend
End Function

Fin.StringToEncoding:
Protected Function StringToEncoding(s as String) As TextEncoding
  dim b as Integer = 0
  dim v as Integer = 0
  dim f as Integer = 0
  dim a(-1) as String = s.Split(",")
  if UBound(a) = 2 then
    b = Val(a(0))
    v = Val(a(1))
    f = Val(a(2))
  end
  return GetTextEncoding(b, v, f)
End Function

Fin.EncodingToString:
Protected Function EncodingToString(e as TextEncoding) As String
  return Str(e.Base) + "," + Str(e.Variant) + "," + Str(e.Format)
End Function

Fin.FormatMemoryNice:
Protected Function FormatMemoryNice(x as Double) As String
  ' format a memory value but make it look nice
  dim s as String = ""
  dim xx as Double = x

  if x < 0 then
    xx = -xx
    s = "-"
  end
  if xx < 1024 then
    return s + CStr(R3(x)) + " Byte(s)"
  elseif xx < 1024 * 1024 then
    return s + CStr(R3(xx / 1024)) + " KBytes"
  elseif xx < 1024 * 1024 * 1024 then
    return s + CStr(R3(xx / (1024 * 1024))) + " MBytes"
  else
    return s + CStr(R3(xx / (1024 * 1024 * 1024))) + " GBytes"
  end
End Function

Fin.LaunchFile:
Protected Sub LaunchFile(s as String)
  dim f as FolderItem = GetFolderItem(s)
  if f <> nil then f.Launch
End Sub

Fin.PageSetup:
Protected Sub PageSetup()
  dim ps as PrinterSetup
  ps = new PrinterSetup
  if printerSettings = "" then
    ps.MaxVerticalResolution = -1
    ps.MaxHorizontalResolution = -1
  else
    ps.SetupString = printerSettings
  end
  if ps.PageSetupDialog then
    printerSettings = ps.setupString
    Pool.SetBin("Fin.printerSettings", printerSettings)
    pageSetupCalled = true
  end
End Sub

Fin.PrintIt:
Protected Function PrintIt() As PrinterSetup
  dim ps as PrinterSetup
  ps = new PrinterSetup
  if ps = nil then return nil

  if not pageSetupCalled then PageSetup
  ps.SetupString = printerSettings
  Pool.SetBin("Fin.printerSettings", printerSettings)
End Function

Fin.ImageSizer:
Protected Sub ImageSizer(srcWidth as Integer, srcHeight as Integer, destWidth as Integer, destHeight as Integer)
  ' Fit the src image into the destination size and set the Image* values accordingly.
  ImageLeft = 0
  ImageTop = 0
  ImageWidth = destWidth
  ImageHeight = destHeight
  dim r as Double

  if srcWidth > srcHeight then     ' landscape
    r = srcHeight
    r = r / srcWidth
    ImageTop = (ImageHeight - r * ImageHeight) / 2
    ImageHeight = ImageHeight * r
  elseif srcWidth < srcHeight then     ' portrait
    r = srcWidth
    r = r / srcHeight
    ImageLeft = (ImageWidth - r * ImageWidth) / 2
    ImageWidth = ImageWidth * r
  else     ' square
  end
End Sub

Fin.PrintOpen:
Protected Function PrintOpen(ps as PrinterSetup, lm as Integer, tm as Integer, rm as Integer, bm as Integer) As Graphics
  ' lm is the preferred left margin in inches, tm is top, rm is right and bm is bottom

  ' Initialize the printer and set the Printer* margins according to the minimums supported by the
  ' printer and the passed values.  Return the printerSettings on success or nil on error

  dim g as Graphics = OpenPrinterDialog(ps)
  if g = nil then return nil
  printerSettings = ps.SetupString
  Pool.SetBin("Fin.printerSettings", printerSettings)

  ' The PrinterSetup has Left, Top, Width and Height values.  The Left and Top values are adjusted
  ' so that (0, 0) is where you start printing.  I.e., the Left and Top values will be negative or 0.

  ' Calculate left margin.  It is the greater of the printer left margin and the supplied lm value.
  dim x as Integer = lm * ps.HorizontalResolution
  PrinterLeft = 0
  if x > (- ps.PageLeft) then PrinterLeft = x - (- ps.PageLeft)

  PrinterWidth = ps.PageWidth
  x = rm * ps.HorizontalResolution
  dim y as Integer = ps.PageWidth - ps.Width - (-ps.PageLeft) - PrinterLeft     ' y is now the right margin
  if x > y then PrinterWidth = PrinterWidth - (x - y)

  ' now do top/bottom margins
  x = tm * ps.VerticalResolution
  PrinterTop = 0
  if x > (- ps.PageTop) then PrinterTop = x - (- ps.PageTop)

  PrinterHeight = ps.PageHeight
  x = bm * ps.VerticalResolution
  y = ps.PageHeight - ps.Height - (-ps.PageTop) - PrinterTop
  if x > y then PrinterHeight = PrinterHeight - (x - y)

  PrinterScale = ps.VerticalResolution / 72

  ' now print using (Fin.PrinterLeft, Fin.PrintTop) as the top left corner and Fin.PrinterWidth and Fin.PrinterHeight
  ' as the page size
  'MsgBox "ps.PW=" + str(ps.PageWidth) + ", ps.PH=" + str(ps.PageHeight) + Fin.NL + "ps.PL=" + str(ps.PageLeft) + ", ps.PT=" + str(ps.PageTop) + ", ps.W=" + str(ps.Width) + ",  ps.H=" + str(ps.Height) + Fin.NL + "ps.HR=" + str(ps.HorizontalResolution) + ", ps.VR=" + str(ps.VerticalResolution) + Fin.NL + "PL=" + str(PrinterLeft) + ", PT=" + str(PrinterTop) + ", PW=" + str(PrinterWidth) + ", PH=" + str(PrinterHeight)
  return g
End Function

Fin.ToDeg:
Protected Function ToDeg(a as Double) As Double
  return a * 180 / PI
End Function

Fin.ToRad:
Protected Function ToRad(a as Double) As Double
  return a * PI / 180
End Function